home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / pcl4p40.arj / CRC.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-09  |  1KB  |  61 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*  This program is donated to the Public    *)
  4. (*  Domain by MarshallSoft Computing, Inc.   *)
  5. (*  It is provided as an example of the use  *)
  6. (*  of the Personal Communications Library.  *)
  7. (*                                           *)
  8. (*********************************************)
  9.  
  10. {$DEFINE DEBUG}
  11.  
  12. unit crc;
  13.  
  14. interface
  15.  
  16. Function  UpdateCRC(crc:Word;data:Byte):Word;
  17. Function  CalcTable(data,genpoly,accum:Word):Word;
  18. Procedure InitCRC;
  19.  
  20. implementation
  21.  
  22. uses PCL4P, crt;
  23.  
  24. const POLY = $1021;
  25.  
  26. var CRCtable : array[0..255] of Word;
  27.  
  28. (* compute updated CRC *)
  29.  
  30. Function  UpdateCRC(crc:Word;data:Byte):Word;
  31. begin
  32.   UpDateCRC := (crc SHL 8) XOR ( CRCtable[ (crc SHR 8) XOR data] );
  33. end;
  34.  
  35. (* calculate CRC table entry *)
  36.  
  37. Function CalcTable(data,genpoly,accum:Word):Word;
  38. var
  39.   i : Word;
  40. begin
  41.   data := data SHL 8;
  42.   for i := 8 downto 1 do
  43.      begin
  44.        if ( (data XOR accum) AND $8000 <> 0 )
  45.           then accum := (accum SHL 1) XOR genpoly
  46.           else accum := accum SHL 1;
  47.        data := data SHL 1;
  48.      end;
  49.   CalcTable := accum;
  50. end;
  51.  
  52. (* initialize CRC table *)
  53.  
  54. Procedure InitCRC;
  55. var
  56.    i : Integer;
  57. begin
  58.  for i := 0 to 255 do CRCtable[i] := CalcTable(i,POLY,0);
  59. end;
  60.  
  61. end.